home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / rk_plot.zip / PLOT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-13  |  26KB  |  632 lines
  1. {
  2. ┌───────────────────────────────────────────────────────────────────────────┐
  3. │                                                                           │
  4. │ Algorithmen zur grafischen Darstellung einer Funktion z = F(x,y).         │
  5. │                                                                           │
  6. │ Version 1.0                                                               │
  7. │                                                                           │
  8. ├───────────────────────────────────────────────────────────────────────────┤
  9. │ Copyright (C) 1991, Hans-Jürgen Herrler und Dieter Sosna                  │
  10. └───────────────────────────────────────────────────────────────────────────┘
  11. }
  12.  
  13. { Soll in der Routine AlphaPunktSetzen geprüft werden, ob 0 <= x <= GetMaxX
  14.   und 0 <= y <= GetMaxY ist, muß die folgende Compilerdirektive entfernt
  15.   werden:                                                                   }
  16.  
  17. {$DEFINE ALPHA-}
  18.  
  19. {$A+,F+,R-,S-}
  20.  
  21. UNIT Plot;
  22.  
  23. INTERFACE
  24.  
  25. USES Graph;
  26.  
  27. CONST
  28.     { Maximalzahl von Gitterlinien in x- bzw. y-Richtung:                   }
  29.     MaxGitter       = 100;
  30.  
  31. TYPE
  32.     Float           = {$IFOPT N+}   Single;     { falls 80x87 vorhanden ist;
  33.                                                   es ist auch Double möglich}
  34.                       {$ELSE}       Real;
  35.                       {$ENDIF}
  36.  
  37.     FloatPointer    = ^Float;
  38.  
  39. {   Beschreibung der Matrix, die die Werte der darzustellenden Funktion
  40.     enthält:                                                                }
  41.     MatrixParameter = Record
  42.         XGitter,                { Zahl der Gitterlinien bzw. Stützstellen   }
  43.         YGitter     : Word;     {   der Funktion in X- bzw. Y-Richtung, die
  44.                                     Zählung beginnt jeweils bei 1!          }
  45.         ZMin, ZMax  : Float     { kleinster und größter Funktionswert       }
  46.         END;
  47.  
  48.     Projektionsart  = (ZentralProjektion, ParallelProjektion);
  49.  
  50. {   Beschreibung des erzeugten Bildes:                                      }
  51.     BildParameter   = Record
  52.         SchirmLinks,            { Bildschirm-Ausschnitt, in dem die         }
  53.         SchirmRechts,           {   Darstellung erfolgt. Angegeben als      }
  54.         SchirmOben,             {   als Bruchteil von GetMaxX, GetMaxY      }
  55.         SchirmUnten : Float;
  56.         { Farben: }
  57.         ColorLine,                      { Linienfarbe                       }
  58.         ColorFrame,                     { Bildrahmen                        }
  59.         { Folgende Farben nur für Volumenperspektive:                       }
  60.         ColorFillO,                     { Füllfarbe Oberseite               }
  61.         ColorFillU,                     { Füllfarbe Unterseite              }
  62.         ColorFillX,                     { Füllfarbe Seitenflächen parallel X}
  63.         ColorFillY  : Byte;             { Füllfarbe Seitenflächen parallel Y}
  64.         Alpha,                          { horizontaler Betrachtungswinkel   }
  65.         Gamma       : Integer;          { vertikaler   Betrachtungswinkel   }
  66.         Case
  67.             Projekt : Projektionsart    {hier gewünschte Projektion angeben }
  68.             Of
  69.             ZentralProjektion:
  70.                 (Abstand,               { Betrachtungsabstand               }
  71.                 Brennweite  : Word);    { Brennweite                        }
  72.             ParallelProjektion:
  73.              (BrennweiteZuAbstand: Float) { Beeinflußt Größe bei Parallel-
  74.                                             projektion                      }
  75.         END;
  76.  
  77. { ------------------------------------------------------------------------- }
  78.  
  79. PROCEDURE VolumenPerspektive(VAR Matrix; MatrixParm: MatrixParameter;
  80.                                 BildParm: BildParameter; UseHeap: Boolean);
  81. PROCEDURE AlphaScheibenPerspektive(VAR Matrix; MatrixParm: MatrixParameter;
  82.                                 BildParm: BildParameter);
  83. PROCEDURE GitterFlaechenPerspektive(VAR Matrix; MatrixParm: MatrixParameter;
  84.                                 BildParm: BildParameter; UseHeap: Boolean);
  85.  
  86. FUNCTION Element(P: Pointer; i, j, SpaltenLen: Word): FloatPointer;
  87. { Liefert Zeiger auf das Matrixelement(i, j) zurück.                        }
  88.  
  89. { ========================================================================= }
  90.  
  91. IMPLEMENTATION
  92.  
  93. TYPE
  94.     GitterPktRec    = Record
  95.         XNr, YNr: Word;                     { Indizes des Gitterpunktes     }
  96.         ZPtr    : FloatPointer;             { Zeiger auf Z-Wert             }
  97.         END;
  98.  
  99. {   Konstanten für die Transformation in Gerätekoordinaten und zur
  100.     Bilderzeugung:                                                          }
  101.     TransformationsParameter    = Record
  102.         D1, D2, D3, D4, D5,             { Transformationskonstanten,        }
  103.         D6, D7, D8,                     {   beschreiben die resultierende   }
  104.         T1, T2, T3,                     {   Matrix aller Transformationen   }
  105.         GTX, GTY            : Float;
  106.         ZSockel             : Float;
  107.         iKrit, jKrit        : Integer;  { "kritische" Gitterlinien, abhängig
  108.                                             von der Lage des Augpunktes     }
  109.         VonUntenSichtbar    : Boolean;
  110.         Richtung            : 'X'..'Y'; { Richtung bei Scheibenperspektive  }
  111.         XGitter,
  112.         YGitter             : Word;
  113.         Case
  114.             Projekt : Projektionsart Of
  115.             ParallelProjektion:
  116.              (BrennweiteZuAbstand: Float) { Beeinflußt Größe bei Parallel-
  117.                                             projektion                      }
  118.         END;
  119.  
  120.     TempArray   = Array[1..MaxGitter*MaxGitter] Of PointType;
  121.     TempArrayPtr= ^TempArray;
  122.  
  123. VAR
  124.     TrfParm     : TransformationsParameter;
  125.     SizeOfFloat : Word;
  126.  
  127. { ------------------------------------------------------------------------- }
  128. FUNCTION Minimum(a, b: Integer): Integer;
  129. BEGIN
  130.     IF a < b THEN Minimum := a ELSE Minimum := b
  131.     END;
  132. { ------------------------------------------------------------------------- }
  133. FUNCTION Maximum(a, b: Integer): Integer;
  134. BEGIN
  135.     IF a > b THEN Maximum := a ELSE Maximum := b
  136.     END;
  137. { ------------------------------------------------------------------------- }
  138. {$L ZEIGER.OBJ}
  139. FUNCTION Element(P: Pointer; i, j, SpaltenLen: Word): FloatPointer;
  140. External;                                                     
  141. { Liefert Zeiger auf das Matrixelement(i, j) zurück.                        }
  142. { ------------------------------------------------------------------------- }
  143. PROCEDURE IncPtr(Var P: FloatPointer);
  144. External;
  145. { Rückt den bereits normalisierten(!) Zeiger auf das folgende Matrixelement.}
  146. { ------------------------------------------------------------------------- }
  147. PROCEDURE Transformation(MatrixParm: MatrixParameter;
  148.                                 BildParm: BildParameter);
  149. {   Berechnet Transformationskonstanten entsprechend der gewünschten
  150.     Darstellung. Aufruf darf erst nach InitGraph erfolgen!                  }
  151.  
  152. CONST
  153. {   Folgende Konstanten charakterisieren die Transformation der Funktion:
  154.     Abzubildender Quader in Weltkoordinaten (Funktion nach der Skalierung)  }
  155.     XWMin           = -100;     XWMax           = +100;
  156.     YWMin           = -100;     YWMax           = +100;
  157.     ZWMin           =  -50;     ZWMax           =  +50;
  158. {   Fenster in Weltkoordinaten ("Mattscheibe" in der Fotografie)            }
  159.     UMin            = -18;      UMax            = +18;
  160.     VMin            = -12;      VMax            = +12;
  161.  
  162.     Sockel          = 0.2;      { Sockelhöhe als Bruchteil von  ZMax-ZMin   }
  163.  
  164. VAR
  165.     AlphaBogen, GammaBogen,     { Betrachtungswinkel im Bogenmaß            }
  166.     SA, SG, CA, CG,             { Sinus und Cosinus von Alpha bzw Gamma     }
  167.     SFX, STX, SFY, STY,         { Konstanten der Skalierungs-Transformation }
  168.     SFZ, STZ,
  169.     GFX, GFY            : Float;    { Konstanten der Geräte-Transformation  }
  170. {   Zur Bezeichnung:
  171.         S = Skalierungs-Transformation: reale Funktion -> Weltkoordinaten
  172.         G = Geräte-Transformation:
  173.             Fenster in Weltkoord. -> Ausschnitt in Gerätekoordinaten
  174.         F = Faktor  T = Translation                                         }
  175.     SchirmL, SchirmR,                   { Bildschirm-Ausschnitt in          }
  176.     SchirmO, SchirmU    : Integer;      {   Geräte-Koordinaten              }
  177.     AX, AY              : Float;        { Weltkoordinaten des Augpunktes    }
  178.     a, b                : Float;        { Hilfsvariable                     }
  179.     Sektor              : 0..7;         { zur Klassifikation von Alpha      }
  180.  
  181. BEGIN
  182.   WITH TrfParm DO BEGIN
  183.     Projekt := BildParm.Projekt;
  184.     IF Projekt = ParallelProjektion THEN
  185.         BrennweiteZuAbstand := BildParm.BrennweiteZuAbstand;
  186.     XGitter := MatrixParm.XGitter;
  187.     YGitter := MatrixParm.YGitter;
  188.  
  189. {   ViewPort festlegen, Rahmen zeichnen                                     }
  190.     WITH BildParm DO BEGIN
  191.         SchirmL := Round(GetMaxX * SchirmLinks);
  192.         SchirmR := Round(GetMaxX * SchirmRechts);
  193.         SchirmO := Round(GetMaxY * SchirmOben);
  194.         SchirmU := Round(GetMaxY * SchirmUnten);
  195.         SetColor(ColorFrame);
  196.         Rectangle(SchirmL, SchirmO, SchirmR, SchirmU);
  197.         SetViewPort(Succ(SchirmL), Succ(SchirmO),
  198.             Pred(SchirmR), Pred(SchirmU), ClipOn);
  199.  
  200. {   Berechnung von Transformationskonstanten                                }
  201.         AlphaBogen := Alpha * Pi / 180;     GammaBogen := Gamma * Pi/ 180;
  202.         SA := Sin(AlphaBogen);              SG := Sin(GammaBogen);
  203.         CA := Cos(AlphaBogen);              CG := Cos(GammaBogen);
  204.         END;
  205.  
  206.     WITH MatrixParm DO BEGIN
  207.         IF ZMax = ZMin THEN ZMax := Abs(ZMin) * 2 + 1;
  208.         ZSockel := ZMin - (ZMax - ZMin) * Sockel;
  209.         SFX := (XWMax - XWMin)/Pred(XGitter);   STX := XWMin - SFX;
  210.         SFY := (YWMax - YWMin)/Pred(YGitter);   STY := YWMin - SFY;
  211.         SFZ := (ZWMax - ZWMin)/(ZMax-ZSockel);  STZ := ZWMin - SFZ * ZSockel
  212.         END;
  213.  
  214.     GFX := (SchirmR - SchirmL)/(UMax - UMin);
  215.     GTX := - GFX * UMin;
  216.     GFY := (SchirmO - SchirmU)/(VMax - VMin);
  217.     GTY := SchirmU - GFY * VMin - SchirmO;
  218. {   Eigentlich:     GTX := SchirmL - GFX * UMin
  219.                     GTY := SchirmU - GFY * VMin ,
  220.     durch das eingestellte Grafikfenster ergeben sich aber Verschiebungen!  }
  221.     D1 := GFX * SFX * CA;           D2 := GFX * SFY * SA;
  222.     D3 := -GFY * SFX * SA * SG;     D4 := GFY * SFY * CA * SG;
  223.     D5 := GFY * SFZ * CG;
  224.     T1 := GFX *(STX * CA + STY * SA);
  225.     T2 := GFY *(-STX * SA * SG + STY * CA * SG + STZ * CG);
  226.  
  227.     WITH BildParm DO IF Projekt = ZentralProjektion THEN BEGIN
  228.         D6 := -SFX * SA * CG / Brennweite;
  229.         D7 := SFY * CA * CG / Brennweite;
  230.         D8 := -SFZ * SG / Brennweite;
  231.         T3 := (-STX * SA * CG + STY * CA * CG - STZ * SG + Abstand)/Brennweite
  232.         END;
  233.  
  234. {   Richtung der Projektionsstrahlen bzw. Lage des Auges:                   }
  235.     WITH BildParm DO IF Projekt = ParallelProjektion THEN BEGIN
  236.         Sektor := ((Alpha + 180) Div 45) Mod 8;
  237.         CASE Sektor OF
  238.             0,1,2,3 : jKrit := -1;
  239.             4,5,6,7 : jKrit := XGitter+2
  240.             END;
  241.         CASE Sektor OF
  242.             2,3,4,5 : iKrit := -1;
  243.             0,1,6,7 : iKrit := YGitter+2
  244.             END;
  245.         CASE Sektor OF          { Vorzugsrichtung bei ScheibenPerspektive   }
  246.             0,3,4,7 : Richtung := 'X';
  247.             1,2,5,6 : Richtung := 'Y'
  248.             END;
  249.         IF Gamma < 0 THEN VonUntenSichtbar := True
  250.         ELSE VonUntenSichtbar := False;
  251.         END
  252.  
  253.     ELSE BEGIN  { ZentralProjektion }
  254.         AX := Abstand * CG * SA;    AY := - Abstand * CG * CA;
  255.         a := (XGitter - 1) / (XWMax - XWMin);
  256.         b := 1 - a * XWMin;
  257.         jKrit := Trunc(a * AX + b);
  258.         a := (YGitter - 1) / (YWMax - YWMin);
  259.         b := 1 - a * YWMin;
  260.         iKrit := Trunc(a * AY + b);
  261.         IF Abstand * SG < ZWMin THEN VonUntenSichtbar := True
  262.         ELSE VonUntenSichtbar := False
  263.         END
  264.       END
  265.     END;    { Transformation }
  266. { ------------------------------------------------------------------------- }
  267. PROCEDURE Projektion(RaumPkt: GitterPktRec; Var BildPkt: PointType);
  268. {   Transformation in Gerätekoordinaten                                     }
  269. VAR
  270.     FT  : Float;
  271. BEGIN
  272.     WITH TrfParm DO WITH RaumPkt DO BEGIN
  273.         IF Projekt = ZentralProjektion THEN
  274.             FT := 1 / (D6 * XNr + D7 * YNr + D8 * ZPtr^ + T3)
  275.         ELSE    { ParallelProjektion }
  276.             FT := BrennweiteZuAbstand;
  277.         BildPkt.X := Round((D1 * XNr + D2 * YNr + T1)* FT + GTX);
  278.         BildPkt.Y := Round((D3 * XNr + D4 * YNr + D5 * ZPtr^ + T2)* FT + GTY)
  279.         END
  280.     END;    { Projektion }
  281. { ------------------------------------------------------------------------- }
  282. FUNCTION VorabProjektion(VAR Matrix; VAR TrfMatrix: TempArrayPtr): Boolean;
  283. { Projiziert die gesamte Matrix vorab auf Gerätekoordinaten, falls temporär
  284.   genug Platz auf dem Heap vorhanden ist.                                   }
  285. VAR
  286.     Size    : LongInt;
  287.     i, j    : Word;
  288.     GP      : GitterPktRec;
  289. BEGIN
  290.     WITH TrfParm DO BEGIN
  291.         Size := XGitter * YGitter * SizeOf(PointType);
  292.         IF MaxAvail >= Size THEN BEGIN
  293.             VorabProjektion := True;
  294.             GetMem(TrfMatrix, Size);
  295.             WITH GP DO FOR i := 1 TO YGitter DO BEGIN
  296.                 YNr := i;
  297.                 XNr := 1;
  298.                 ZPtr := Element(@Matrix, YNr, XNr, XGitter);
  299.                 Projektion(GP, TempArray(TrfMatrix^)[Pred(i)*XGitter+1]);
  300.                 FOR j := 2 TO XGitter DO BEGIN
  301.                     Inc(XNr);
  302.                     IncPtr(ZPtr);
  303.                     Projektion(GP, TempArray(TrfMatrix^)[Pred(i)*XGitter+j])
  304.                     END
  305.                 END
  306.             END
  307.         ELSE VorabProjektion := False
  308.         END
  309.     END;
  310.  
  311. { ======= VolumenPerspektive ============================================== }
  312.  
  313. PROCEDURE VolumenPerspektive(VAR Matrix; MatrixParm: MatrixParameter;
  314.                                 BildParm: BildParameter; UseHeap: Boolean);
  315. VAR
  316.     Vorab       : Boolean;
  317.     TrfMatrix   : TempArrayPtr;
  318. { ......................................................................... }
  319. PROCEDURE Prisma(i, j: Integer);
  320. {   Zeichnet Prisma unter Berücksichtigung der Sichtbarkeit                 }
  321. TYPE
  322.     EckpunktNr      = 1..8; { 8 Eckpunkte eines Prismas werden nummeriert   }
  323.     FlaechenType    = Array[1..4] of EckpunktNr;
  324. CONST
  325. {   Charakterisieren jedes Eckpunktes des Prismas.                          }
  326.     Index           : Array[EckpunktNr,1..2] of Byte    =
  327.                         ((0, 0), (1, 0), (1, 1), (0, 1),
  328.                          (0, 0), (1, 0), (1, 1), (0, 1));
  329. {   Charakterisieren der 6 Flächen des Prismas durch ihre Eckpunktnummern:  }
  330.     Oben            : FlaechenType  = (5, 6, 7, 8);
  331.     Unten           : FlaechenType  = (1, 2, 3, 4);
  332.     LinksX          : FlaechenType  = (1, 4, 8, 5);
  333.     RechtsX         : FlaechenType  = (2, 3, 7, 6);
  334.     LinksY          : FlaechenType  = (1, 2, 6, 5);
  335.     RechtsY         : FlaechenType  = (4, 3, 7, 8);
  336. { ......................................................................... }
  337. PROCEDURE Viereck(Flaeche: FlaechenType);
  338. {   Angegebene Fläche zeichnen (Inneres dabei löschen)                      }
  339. VAR
  340.     k       : 1..4;
  341.     Ecke    : EckPunktNr;
  342.     GP      : GitterPktRec;
  343.     Polygon : Array[1..4] Of PointType;
  344. BEGIN
  345.     WITH GP DO FOR k := 1 TO 4 DO BEGIN
  346.         Ecke := Flaeche[k];
  347.         XNr := j + Index[Ecke, 1];
  348.         YNr := i + Index[Ecke, 2];
  349.         IF Ecke < 5 THEN ZPtr := @TrfParm.ZSockel
  350.         ELSE ZPtr := Element(@Matrix, YNr, XNr, TrfParm.XGitter);
  351.         Projektion(GP, Polygon[k])
  352.         END;
  353.     FillPoly(4, Polygon)
  354.     END;    { Viereck }
  355. { ......................................................................... }
  356. PROCEDURE ViereckOben;
  357. { Entspricht dem Prozeduraufruf Viereck(Oben), ist aber optimiert!          }
  358. VAR
  359.     GP      : GitterPktRec;
  360.     Polygon : Array[1..4] Of PointType;
  361. BEGIN
  362.     IF Vorab THEN WITH TrfParm DO BEGIN
  363.         Polygon[1] := TempArray(TrfMatrix^)[Pred(i)*XGitter + j];
  364.         Polygon[2] := TempArray(TrfMatrix^)[Pred(i)*XGitter + Succ(j)];
  365.         Polygon[3] := TempArray(TrfMatrix^)[i*XGitter + Succ(j)];
  366.         Polygon[4] := TempArray(TrfMatrix^)[i*XGitter + j]
  367.         END
  368.     ELSE WITH GP DO BEGIN
  369.         XNr := j;   YNr := i;
  370.         ZPtr := Element(@Matrix, YNr, XNr, TrfParm.XGitter);
  371.         Projektion(GP, Polygon[1]);
  372.         Inc(XNr);
  373.         IncPtr(ZPtr);
  374.         Projektion(GP, Polygon[2]);
  375.         Dec(XNr);   Inc(YNr);
  376.         ZPtr := Element(@Matrix, YNr, XNr, TrfParm.XGitter);
  377.         Projektion(GP, Polygon[4]);
  378.         Inc(XNr);
  379.         IncPtr(ZPtr);
  380.         Projektion(GP, Polygon[3])
  381.         END;
  382.     FillPoly(4, Polygon)
  383.     END;    { ViereckOben }
  384. { ......................................................................... }
  385. BEGIN   { Prisma }
  386.     SetFillStyle(SolidFill, BildParm.ColorFillO);
  387.     ViereckOben;
  388.     WITH TrfParm DO BEGIN
  389. {       Nur wirklich sichtbare Seitenflächen zeichnen:                      }
  390.         IF (j=1)                and (j>jKrit) THEN BEGIN
  391.             SetFillStyle(SolidFill, BildParm.ColorFillY);
  392.             Viereck(LinksX)
  393.             END;
  394.         IF (j=pred(XGitter))    and (j<jKrit) THEN BEGIN
  395.             SetFillStyle(SolidFill, BildParm.ColorFillY);
  396.             Viereck(RechtsX)
  397.             END;
  398.         IF (i=1)                and (i>iKrit) THEN BEGIN
  399.             SetFillStyle(SolidFill, BildParm.ColorFillX);
  400.             Viereck(LinksY)
  401.             END;
  402.         IF (i=pred(YGitter))    and (i<iKrit) THEN BEGIN
  403.             SetFillStyle(SolidFill, BildParm.ColorFillX);
  404.             Viereck(RechtsY)
  405.             END;
  406.         IF VonUntenSichtbar                   THEN BEGIN
  407.             SetFillStyle(SolidFill, BildParm.ColorFillU);
  408.             Viereck(Unten)
  409.             END
  410.         END
  411.     END;    { Prisma }
  412. { ......................................................................... }
  413. VAR
  414.     i, j    : Integer;
  415.  
  416. BEGIN   { VolumenPerspektive }
  417.     Transformation(MatrixParm, BildParm);
  418.     Vorab := False;
  419.     IF UseHeap THEN Vorab := VorabProjektion(Matrix, TrfMatrix);
  420.     SetColor(BildParm.ColorLine);
  421.  
  422.     WITH TrfParm DO BEGIN
  423.  
  424.         FOR i := 1 TO Pred(Minimum(iKrit, YGitter)) DO
  425.             FOR j := 1 TO Pred(Minimum(jKrit, XGitter)) DO Prisma(i, j);
  426.  
  427.         FOR j := Pred(XGitter) DOWNTO Maximum(jKrit, 1) DO
  428.             FOR i := 1 TO Pred(Minimum(iKrit, YGitter)) DO Prisma(i, j);
  429.  
  430.         FOR j := 1 TO Pred(Minimum(jKrit, XGitter)) DO
  431.             FOR i := Pred(YGitter) DOWNTO Maximum(iKrit, 1) DO Prisma(i, j);
  432.  
  433.         FOR i := Pred(YGitter) DOWNTO Maximum(iKrit, 1) DO
  434.             FOR j := Pred(XGitter) DOWNTO Maximum(jKrit, 1) DO Prisma(i, j);
  435.  
  436.         IF Vorab THEN FreeMem(TrfMatrix, XGitter*YGitter*SizeOf(PointType))
  437.         END;
  438.  
  439.     SetViewPort(0, 0, GetMaxX, GetMaxY, ClipOn)
  440.     END;    { VolumenPerspektive }
  441.  
  442. { ======= Modifizierter Alpha-Puffer-Algorithmus ========================== }
  443.  
  444. TYPE
  445.     PointArrayType  = Array[1..MaxGitter+3] Of PointType;
  446. VAR
  447.     maxTemp, minTemp,
  448.     AlphaMax, AlphaMin  : Array[0..719] of Integer;
  449.                                         { ausreichend für CGA, HGC, EGA     }
  450.     AlphaColor          : Byte;
  451.  
  452. {$IFDEF ALPHA-} {$L ALPHA-.OBJ}
  453. {$ELSE}         {$L ALPHA.OBJ}
  454. {$ENDIF}
  455.  
  456. PROCEDURE AlphaLine(P1, P2: PointType);             External;
  457. {Zeichnet eine Linie von P1 nach P2 gemäß modifiziertem α-Puffer-Algorithmus}
  458.  
  459. PROCEDURE InitAlphaPuffer;                          External;
  460.  
  461. PROCEDURE AlphaPufferAktualisieren;                 External;
  462.  
  463. { ------------------------------------------------------------------------- }
  464. PROCEDURE AlphaPolyLine(NumPoints: Word; PolyPoints: PointArrayType);
  465. VAR
  466.     i   : Word;
  467. BEGIN
  468.     FOR i := 1 TO Pred(NumPoints) DO
  469.         AlphaLine(PolyPoints[i], PolyPoints[Succ(i)])
  470.     END;
  471.  
  472. { ======= AlphaScheibenPerspektive ======================================== }
  473.  
  474. VAR
  475.     Polygon         : PointArrayType;
  476.  
  477. PROCEDURE AlphaScheibenPerspektive(VAR Matrix; MatrixParm: MatrixParameter;
  478.                                     BildParm: BildParameter);
  479. { ......................................................................... }
  480. PROCEDURE AlphaScheibeX(i: integer);        { eine Scheibe parallel X-Achse }
  481. VAR
  482.     k       : Word;
  483.     GP      : GitterPktRec;
  484. BEGIN
  485.     WITH GP DO BEGIN
  486.         XNr := 1;
  487.         YNr := i;
  488.         ZPtr := Element(@Matrix, YNr, XNr, TrfParm.XGitter);
  489.         Projektion(GP, Polygon[1]);
  490.         FOR k := 2 TO TrfParm.XGitter DO BEGIN
  491.             Inc(XNr);
  492.             IncPtr(ZPtr);
  493.             Projektion(GP, Polygon[k])
  494.             END;
  495.         ZPtr := @TrfParm.ZSockel;
  496.         Projektion(GP, Polygon[Succ(TrfParm.Xgitter)]);
  497.         XNr := 1;
  498.         Projektion(GP, Polygon[TrfParm.Xgitter+2]);
  499.         Polygon[TrfParm.XGitter+3] := Polygon[1];
  500.         END;
  501.     AlphaPolyLine(TrfParm.XGitter+3, Polygon);
  502.     AlphaPufferAktualisieren
  503.     END;    { AlphaScheibeX }
  504. { ......................................................................... }
  505. PROCEDURE AlphaScheibeY(j: integer);        { eine Scheibe parallel Y-Achse }
  506. VAR
  507.     k       : Word;
  508.     GP      : GitterPktRec;
  509. BEGIN
  510.     WITH GP DO BEGIN
  511.         XNr := j;
  512.         YNr := 1;
  513.         ZPtr := Element(@Matrix, YNr, XNr, TrfParm.XGitter);
  514.         Projektion(GP, Polygon[1]);
  515.         FOR k := 2 TO TrfParm.YGitter DO BEGIN
  516.             Inc(YNr);
  517.             ZPtr := Element(@Matrix, YNr, XNr, TrfParm.XGitter);
  518.             Projektion(GP, Polygon[k])
  519.             END;
  520.         ZPtr := @TrfParm.ZSockel;
  521.         Projektion(GP, Polygon[Succ(TrfParm.Ygitter)]);
  522.         YNr := 1;
  523.         Projektion(GP, Polygon[TrfParm.Ygitter+2]);
  524.         Polygon[TrfParm.YGitter+3] := Polygon[1];
  525.         END;
  526.     AlphaPolyLine(TrfParm.YGitter+3, Polygon);
  527.     AlphaPufferAktualisieren
  528.     END;    { AlphaScheibeY }
  529. { ......................................................................... }
  530. VAR
  531.     i, j    : Integer;
  532. BEGIN   { AlphaScheibenPerspektive }
  533.     Transformation(MatrixParm, BildParm);
  534.     InitAlphaPuffer;
  535.     AlphaColor := BildParm.ColorLine;
  536.  
  537.     WITH TrfParm DO
  538.     IF Richtung = 'X' THEN BEGIN    { Scheiben parallel X-Achse             }
  539.         FOR i := Maximum(Succ(iKrit), 1) TO YGitter DO AlphaScheibeX(i);
  540.         FOR i := Minimum(iKrit, YGitter) DOWNTO 1 DO AlphaScheibeX(i)
  541.         END
  542.     ELSE BEGIN  { Richtung = 'Y' , d.h. Scheiben parallel Y-Achse           }
  543.         FOR j := Maximum(Succ(jKrit), 1) TO XGitter DO AlphaScheibeY(j);
  544.         FOR j := Minimum(jKrit, XGitter) DOWNTO 1 DO AlphaScheibeY(j)
  545.         END;
  546.  
  547.     SetViewPort(0, 0, GetMaxX, GetMaxY, ClipOn)
  548.     END;    { AlphaScheibenPerspektive }
  549.  
  550. { ======= GitterFlächenPerspektive ======================================== }
  551.  
  552. PROCEDURE GitterFlaechenPerspektive(VAR Matrix; MatrixParm: MatrixParameter;
  553.                                 BildParm: BildParameter; UseHeap: Boolean);
  554. VAR
  555.     Vorab       : Boolean;
  556.     { Wurde die ganze Matrix vorab auf Gerätekoordinaten transformiert? }
  557.     TrfMatrix   : TempArrayPtr;
  558.  
  559. { ......................................................................... }
  560. PROCEDURE Feld(i, j: Integer);  { Zeichnet ein Elementarfeld                }
  561. VAR
  562.     GP      : GitterPktRec;
  563.     Polygon : Array[1..4] Of PointType;
  564. BEGIN
  565.     IF Vorab THEN WITH TrfParm DO BEGIN
  566.         Polygon[1] := TempArray(TrfMatrix^)[Pred(i)*XGitter + j];
  567.         Polygon[2] := TempArray(TrfMatrix^)[Pred(i)*XGitter + Succ(j)];
  568.         Polygon[3] := TempArray(TrfMatrix^)[i*XGitter + Succ(j)];
  569.         Polygon[4] := TempArray(TrfMatrix^)[i*XGitter + j]
  570.         END
  571.     ELSE WITH GP DO BEGIN
  572.         XNr := j;   YNr := i;
  573.         ZPtr := Element(@Matrix, YNr, XNr, TrfParm.XGitter);
  574.         Projektion(GP, Polygon[1]);
  575.         Inc(XNr);
  576.         IncPtr(ZPtr);
  577.         Projektion(GP, Polygon[2]);
  578.         Dec(XNr);   Inc(YNr);
  579.         ZPtr := Element(@Matrix, YNr, XNr, TrfParm.XGitter);
  580.         Projektion(GP, Polygon[4]);
  581.         Inc(XNr);
  582.         IncPtr(ZPtr);
  583.         Projektion(GP, Polygon[3])
  584.         END;
  585.  
  586.     WITH TrfParm DO BEGIN
  587.         IF (i <= iKrit) or (i = 1) THEN AlphaLine(Polygon[1], Polygon[2]);
  588.         IF (j >= jKrit) or (j = Pred(XGitter)) THEN
  589.                         AlphaLine(Polygon[2], Polygon[3]);
  590.         IF (i >= iKrit) or (i = Pred(YGitter)) THEN
  591.                         AlphaLine(Polygon[3], Polygon[4]);
  592.         IF (j <= jKrit) or (j = 1) THEN AlphaLine(Polygon[4], Polygon[1])
  593.         END;
  594.  
  595.     AlphaPufferAktualisieren
  596.     END;    { Feld }
  597. { ......................................................................... }
  598. VAR
  599.     i, j    : Integer;
  600.  
  601. BEGIN   { GitterFlaechenPerspektive }
  602.     Transformation(MatrixParm, BildParm);
  603.     Vorab := False;
  604.     IF UseHeap THEN Vorab := VorabProjektion(Matrix, TrfMatrix);
  605.     AlphaColor := BildParm.ColorLine;
  606.     InitAlphaPuffer;
  607.  
  608.     WITH TrfParm DO BEGIN
  609.         FOR i := Maximum(iKrit, 1) TO Pred(YGitter) DO
  610.             FOR j := Minimum(jKrit, Pred(XGitter)) DOWNTO 1 DO Feld(i, j);
  611.  
  612.         FOR j := Maximum(succ(jKrit), 1) TO Pred(XGitter) DO
  613.             FOR i := Maximum(iKrit, 1) TO Pred(YGitter) DO Feld(i, j);
  614.  
  615.         FOR i := Pred(Minimum(iKrit, YGitter)) DOWNTO 1 DO
  616.             FOR j := Maximum(jKrit, 1) TO Pred(XGitter) DO Feld(i, j);
  617.  
  618.         FOR j := Pred(Minimum(jKrit, XGitter)) DOWNTO 1 DO
  619.             FOR i := Pred(Minimum(iKrit, YGitter)) DOWNTO 1 DO Feld(i, j);
  620.  
  621.         IF Vorab THEN FreeMem(TrfMatrix, XGitter * YGitter * SizeOf(PointType))
  622.         END;
  623.  
  624.     SetViewPort(0, 0, GetMaxX, GetMaxY, ClipOn)
  625.     END;    { GitterFlaechenPerspektive }
  626.  
  627. { ======= Initialisierungen =============================================== }
  628.  
  629. BEGIN
  630.     SizeOfFloat := SizeOf(Float)
  631.     END.
  632.